home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istpo / ISTPO.MAC.f
Encoding:
Text File  |  1989-03-04  |  41.8 KB  |  1,254 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.5
  3. C---------------------------------------------------------
  4.         PROGRAM ISTPO
  5.  
  6. C ----------------------------------------------------------------------
  7. C
  8. C       I S T P O   -   P O L I S H   O P T I O N S   E D I T O R
  9. C       =========       =========================================
  10. C
  11. C ----------------------------------------------------------------------
  12.  
  13.         INTEGER CMDTBL(45),MENTBL(83),MENTBX(10)
  14.  
  15.         INTEGER PROMPT(5),FPRMPT(19),MPRMPT(12),VPRMPT(18,9)
  16.  
  17.         SAVE
  18.  
  19.         INTEGER OPTPTH(81),IODOPT,JUNK,CMD(134),MENU,CMDLEN,
  20.      +          CMDNUM,KEYWRD(134),PNTR,REST(134),TEMP
  21.         LOGICAL VERBOS
  22.  
  23.         INTEGER OPEN,GETARG,ZKWLUK,ZGTCMD,GETWRD,ZYESNO
  24.         EXTERNAL OPEN,GETARG,ZKWLUK,ZGTCMD,GETWRD,ZPRMPT,ZYESNO,CANT,
  25.      +           ZINIT,ZQUIT,SKIPBL,SKIP
  26.  
  27.         DATA CMDTBL/9,
  28.      +       63,129,
  29.      +       101,120,105,116,129,
  30.      +       104,101,108,112,129,
  31.      +       109,101,110,117,129,
  32.      +       110,101,120,116,129,
  33.      +       113,117,101,114,121,129,
  34.      +       113,117,105,116,129,
  35.      +       114,101,97,100,129,
  36.      +       119,114,105,116,101,129/
  37.  
  38.         DATA MENTBL/10,
  39.      +       98,97,115,105,99,129,
  40.      +       98,108,97,110,107,95,108,105,110,101,
  41.      +115,129,
  42.      +       99,111,109,109,111,110,129,
  43.      +       99,111,110,118,101,114,115,105,111,110,129,
  44.      +       100,105,114,129,
  45.      +       108,105,110,101,95,98,114,101,97,107,129,
  46.      +       115,112,97,99,105,110,103,49,129,
  47.      +       115,112,97,99,105,110,103,50,129,
  48.      +       116,111,112,129,
  49.      +       117,110,99,111,109,109,111,110,129/
  50.  
  51.         DATA MENTBX/2,6,3,5,1,7,8,9,1,4/
  52.  
  53.         DATA PROMPT/80,79,62,32,129/
  54.  
  55.         DATA FPRMPT/79,112,116,105,111,110,32,102,105,108,
  56.      +              101,32,110,97,109,101,58,32,129/
  57.  
  58.         DATA MPRMPT/77,101,110,117,32,110,97,109,101,
  59.      +              58,32,129/
  60.  
  61.         DATA (VPRMPT(I,1),I=1,10)/80,79,40,100,105,114,
  62.      +        41,62,32,129/
  63.         DATA (VPRMPT(I,2),I=1,12)/80,79,40,98,97,115,
  64.      +        105,99,41,62,32,129/
  65.         DATA (VPRMPT(I,3),I=1,13)/80,79,40,99,111,109,
  66.      +        109,111,110,41,62,32,129/
  67.         DATA (VPRMPT(I,4),I=1,15)/80,79,40,117,110,99,
  68.      +        111,109,109,111,110,41,62,32,129/
  69.         DATA (VPRMPT(I,5),I=1,17)/80,79,40,99,111,110,
  70.      +        118,101,114,115,105,111,110,
  71.      +        41,62,32,129/
  72.         DATA (VPRMPT(I,6),I=1,18)/80,79,40,98,108,97,
  73.      +        110,107,95,108,105,110,101,115,41,
  74.      +        62,32,129/
  75.         DATA (VPRMPT(I,7),I=1,17)/80,79,40,108,105,110,
  76.      +        101,95,98,114,101,97,107,41,62,
  77.      +        32,129/
  78.         DATA (VPRMPT(I,8),I=1,15)/80,79,40,115,112,97,
  79.      +        99,105,110,103,49,41,62,32,129/
  80.         DATA (VPRMPT(I,9),I=1,15)/80,79,40,115,112,97,
  81.      +        99,105,110,103,50,41,62,32,129/
  82.  
  83.         CALL ZINIT
  84.  
  85.         IF (GETARG(1,OPTPTH,81).EQ.-100) THEN
  86.             CALL ZPRMPT(FPRMPT)
  87.             JUNK=ZGTCMD(OPTPTH,0)
  88.             IF (JUNK.EQ.-100 .OR. JUNK.EQ.129) CALL ERROR
  89.      +          ('Option file name must be specified.')
  90.         END IF
  91.  
  92. C Read previous option file
  93.  
  94.         IODOPT=OPEN(OPTPTH,0)
  95.         IF (IODOPT.EQ.-1) THEN
  96.             CALL ZMESS('[New file]',1)
  97.         ELSE
  98.             CALL ZMESS('[Reading old file......]',1)
  99.  100        IF (ZGTCMD(CMD,IODOPT).NE.-100) THEN
  100.                 CALL POLOPT(CMD,.FALSE.)
  101.                 GOTO 100
  102.             END IF
  103.             CALL CLOSE(IODOPT)
  104.         END IF
  105.  
  106. C Initialise menu system
  107.  
  108.         MENU=1
  109.         VERBOS=.FALSE.
  110.  
  111. C Main loop
  112.  
  113.  200    CALL SKIP(1)
  114.         IF (VERBOS) THEN
  115.             CALL ZPRMPT(VPRMPT(1,MENU))
  116.         ELSE
  117.             CALL ZPRMPT(PROMPT)
  118.         END IF
  119.         CMDLEN=ZGTCMD(CMD,0)
  120.         IF (CMDLEN.EQ.0) GOTO 200
  121.         PNTR=1
  122.         IF (GETWRD(CMD,PNTR,KEYWRD).LE.0) GOTO 200
  123.         CALL SKIPBL(CMD,PNTR)
  124.         CALL SCOPY(CMD,PNTR,REST,1)
  125.         CMDNUM=ZKWLUK(KEYWRD,CMDTBL)
  126.         IF (CMDNUM.GT.0) THEN
  127.             GOTO (1001,1002,1003,1004,1005,1006,1007,1008,1009) CMDNUM
  128.         ELSE IF (CMDNUM.EQ.0) THEN
  129.             CALL REMARK('Ambiguous command')
  130.         ELSE
  131.             CALL POLOPT(CMD,.FALSE.)
  132.         END IF
  133.         GOTO 200
  134.  
  135. C ****************************************
  136. C *
  137. C *     Basic command routines
  138. C *
  139. C ****************************************
  140.  
  141. C ?
  142.  1001   CALL ZMESS(
  143.      +'Commands are: Exit, Help, Menu, Next, Query, Quit, Read, Write',
  144.      +       1)
  145.         CALL PUTC(10)
  146.         CALL ZMESS('To set a parameter, type:',1)
  147.         CALL ZMESS('    param=value.',1)
  148.         CALL PUTC(10)
  149.         GOTO 200
  150.  
  151. C Exit
  152.  1002   IF (REST(1).NE.129) THEN
  153.             CALL REMARK('The EXIT comand should have n'//'o parameters')
  154.         ELSE
  155.             CALL WRFILE(OPTPTH)
  156.             CALL ZQUIT(-2)
  157.         END IF
  158.         GOTO 200
  159.  
  160. C Help
  161.  1003   CALL HELP(REST,MENU)
  162.         VERBOS=.TRUE.
  163.         GOTO 200
  164.  
  165. C Menu
  166.  1004   IF (REST(1).EQ.129) THEN
  167.             CALL HELP(REST,MENU)
  168.             VERBOS=.TRUE.
  169.             GOTO 200
  170.         END IF
  171.         TEMP=ZKWLUK(REST,MENTBL)
  172.         IF (TEMP.GT.0) THEN
  173.             MENU=MENTBX(TEMP)
  174.             REST(1)=129
  175.             CALL HELP(REST,MENU)
  176.         ELSE IF (TEMP.EQ.0) THEN
  177.             CALL REMARK('Ambiguous menu name')
  178.         ELSE
  179.             CALL REMARK('Unknown menu name')
  180.         END IF
  181.         GOTO 200
  182.  
  183. C Next
  184.  1005   IF (REST(1).NE.129) THEN
  185.             CALL REMARK('The NEXT command must have n'//'o parameters')
  186.         ELSE
  187.             MENU=MENU+1
  188.             IF (MENU.GT.9) MENU=1
  189.             CALL HELP(REST,MENU)
  190.         END IF
  191.         GOTO 200
  192.  
  193. C Query
  194.  1006   CALL POLOPT(CMD,.FALSE.)
  195.         GOTO 200
  196.  
  197. C Quit
  198.  1007   CALL ZMESS('Quit ISTPO a'//'nd n'//'ot wr'//
  199.      +             'ite the options file?',1)
  200.         IF (ZYESNO(-2).EQ.-2) THEN
  201.             CALL ZMESS('ISTPO terminated, file n'//'ot written',1)
  202.             CALL ZQUIT(-2)
  203.         END IF
  204.         CALL ZMESS('Quit command aborted',1)
  205.         GOTO 200
  206.  
  207. C Read
  208.  1008   IF (REST(1).EQ.129) THEN
  209.             CALL ZPRMPT(FPRMPT)
  210.             JUNK=ZGTCMD(REST,0)
  211.         END IF
  212.         IODOPT=OPEN(REST,0)
  213.         IF (IODOPT.EQ.-1) THEN
  214.             CALL CANT(REST)
  215.         ELSE
  216.  2000       IF (ZGTCMD(CMD,IODOPT).NE.-100) THEN
  217.                 CALL POLOPT(CMD,.FALSE.)
  218.                 GOTO 2000
  219.             END IF
  220.             CALL CLOSE(IODOPT)
  221.         END IF
  222.         GOTO 200
  223.  
  224. C Write
  225.  1009   IF (REST(1).NE.129) CALL SCOPY(REST,1,OPTPTH,1)
  226.         CALL WRFILE(OPTPTH)
  227.         GOTO 200
  228.  
  229.         END
  230. C ----------------------------------------------------------------------
  231. C
  232. C        H E L P  -  Display help
  233. C
  234.  
  235.         SUBROUTINE HELP(TOPIC,MENU)
  236.         INTEGER TOPIC(*),MENU
  237.  
  238. C---------------------------------------------------------
  239. C    TOOLPACK/1    Release: 2.5
  240. C---------------------------------------------------------
  241. C
  242. C  TKLAST = LAST TOKEN NUMBER
  243. C
  244.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  245.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  246.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  247.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  248.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  249.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  250.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  251.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  252.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  253.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  254.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  255.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  256.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  257.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  258.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  259.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  260.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  261.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  262.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  263.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  264.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  265.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  266.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  267.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  268.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  269.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  270.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  271.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  272.  
  273.  
  274.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  275.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  276.  
  277.         COMMON/CONTIN/CONCHR,CONCNT
  278.         INTEGER CONCHR,CONCNT
  279.  
  280.         COMMON/LFORM/LABELF,LABELC
  281.         INTEGER LABELF,LABELC
  282.  
  283.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  284.         INTEGER INDDO,INDIF,INDCON,MAXIND
  285.         LOGICAL INDCMT
  286.  
  287.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  288.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  289.         LOGICAL SEQRQD
  290.  
  291.         COMMON/SPACNG/SPBEF,SPAFT
  292.         INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
  293.  
  294.         COMMON/INTBRK/BRPRIO
  295.         INTEGER BRPRIO(-2:TKLAST,0:2)
  296.  
  297.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  298.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  299.         LOGICAL BLADEC
  300.  
  301.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  302.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  303.         LOGICAL RLBFMT,RLBSTM
  304.  
  305.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  306.         LOGICAL DOCONI,IOTHCO
  307.         INTEGER NDOCON,DOCONS(30)
  308.  
  309.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  310.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  311.  
  312.         COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  313.         INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  314.  
  315.         COMMON/ASGLUP/VLEN
  316.         INTEGER VLEN
  317.  
  318.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  319.         LOGICAL DLUP
  320.         INTEGER DLEN,DLUPOS
  321.  
  322.         COMMON/MOVFMT/MOVEF,MFFLAG
  323.         LOGICAL MOVEF,MFFLAG
  324.  
  325.         COMMON/TRCOPT/TRACE
  326.         LOGICAL TRACE
  327.  
  328.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  329.         LOGICAL INDDOC,DELSED,BRKLIF
  330.  
  331.         COMMON/ERROPT/ERRCMT
  332.         LOGICAL ERRCMT
  333.  
  334.         COMMON/CVTOPT/CVTHFM,FMSBRK
  335.         LOGICAL CVTHFM,FMSBRK
  336.  
  337.         COMMON/REMTOK/RMOPCF
  338.         LOGICAL RMOPCF
  339.  
  340.         COMMON/TNAMES/TOKNAM
  341.         CHARACTER*6 TOKNAM(-2:TKLAST)
  342.  
  343.         INTEGER HLPTOP(93),HLPTBX(14)
  344.         CHARACTER*61 HLPTXT(49)
  345.  
  346.         SAVE
  347.  
  348.         INTEGER TOPNUM,I
  349.  
  350.         INTEGER ZKWLUK
  351.         EXTERNAL ZKWLUK,ZMESS
  352.  
  353.         DATA HLPTOP/14,
  354.      +       63,129,
  355.      +       99,98,111,120,61,129,
  356.      +       99,109,99,104,97,114,61,129,
  357.      +       99,109,109,111,100,101,61,129,
  358.      +       99,111,110,99,104,114,61,129,
  359.      +       101,120,105,116,129,
  360.      +       104,101,108,112,129,
  361.      +       109,101,110,117,129,
  362.      +       110,101,120,116,129,
  363.      +       112,97,114,97,109,101,116,101,114,95,
  364.      +115,101,116,116,105,110,103,129,
  365.      +       113,117,101,114,121,129,
  366.      +       113,117,105,116,129,
  367.      +       114,101,97,100,129,
  368.      +       119,114,105,116,101,129/
  369.  
  370.         DATA (HLPTXT(I),I=1,19)/
  371.      +  'Help is currently available on:.                             ',
  372.      +  '  Exit   Help   Menu   Next   Query  Quit   Read   Write.    ',
  373.      +  '  Parameter_setting.                                         ',
  374.      +  '  CBOX=     CMCHAR=   CMMODE=   CONCHR=.                    )',
  375.      +  'The EXIT command will Write out the option file as modified,.',
  376.      +  'And terminate ISTPO...                                      )',
  377.      +  'The HELP command with No parameters will display the current.',
  378.      +  'menu..  Otherwise the parameter is the name of a topic on.   ',
  379.      +  'which to give help..  A list of topics can be displayed by.  ',
  380.      +  'giving the command "HELP ?"...                              )',
  381.      +  'The MENU command sets the menu..  Its parameter is the name. ',
  382.      +  'of the required menu...                                     )',
  383.      +  'The NEXT command will set the menu to that following the.    ',
  384.      +  'current one...                                              )',
  385.      +  'The QUIT command terminates ISTPO without updating the.      ',
  386.      +  'option file...                                              )',
  387.      +  'To set an ISTPL parameter, type the parameter name followed. ',
  388.      +  'by an Equals sign And then the required value...             ',
  389.      +  '    For example:  PO>RLBFMT=..TRUE...                        '/
  390.         DATA (HLPTXT(I),I=20,38)/
  391.      +  'Note that both the parameter And the value name may be.      ',
  392.      +  'abbreviated, so long as they are still unique...            )',
  393.      +  'The CONCHR parameter determines what character will be used. ',
  394.      +  'in column 6 of continuation lines..  The acceptable values.  ',
  395.      +  'are:    CONCHR=numeric.                                      ',
  396.      +  '        CONCHR=alphabetic.                                   ',
  397.      +  '        CONCHR=alphanumeric.                                 ',
  398.      +'        CONCHR=''*''.                                          ',
  399.      +  '(where * is Any graphic character apart from 0...           )',
  400.      +  'The QUERY command asks that each time an option is changed,. ',
  401.      +  'the user is asked for confirmation..  A second QUERY command.',
  402.      +  'will turn QUERY mode off (after confirmation of course)...  )',
  403.      +  'The READ command reads an option file into memory..  This.   ',
  404.      +  'overwrites Any current option setting...                    )',
  405.      +  'The WRITE command writes out the current option settings to. ',
  406.      +  'an option file..  If No filename is specified after the.     ',
  407.      +  'command, the option file specified at startup is written... )',
  408.      +  'The CMMODE parameter determines the mode of processing.      ',
  409.      +  'comments..  The acceptable values are:.                      '/
  410.         DATA (HLPTXT(I),I=39,49)/
  411.      +  '        CMMODE=normal.                                       ',
  412.      +  '        CMMODE=skip_leading_blanks.                          ',
  413.      +  '        CMMODE=verbatim.                                    )',
  414.      +  'The CBOX parameter determines the decoration applied to.     ',
  415.      +  'comment blocks..  The acceptable values are:.                ',
  416.      +  '        CBOX=none.                                           ',
  417.      +  '        CBOX=half_box.                                       ',
  418.      +  '        CBOX=whole_box.                                     )',
  419.      +  'The CMCHAR parameter determines the character in column of.  ',
  420.      +'comment lines..  The acceptable values are: ''C'', ''c'', ''*'',
  421.      + .',
  422.      +'And '' '' (Blank means the same as in the source)...          )'/
  423.  
  424.         DATA HLPTBX/1,42,47,37,22,5,7,11,13,17,29,15,32,34/
  425.  
  426.         IF (TOPIC(1).EQ.129)
  427.      +      GOTO (1001,1002,1003,1004,1005,1006,1007,1008,1009) MENU
  428.  
  429.         TOPNUM=ZKWLUK(TOPIC,HLPTOP)
  430.         IF (TOPNUM.LE.0) THEN
  431.             IF (TOPNUM.EQ.0) THEN
  432.                 CALL REMARK('Ambiguous help topic')
  433.             ELSE
  434.                 CALL REMARK('Unknown help topic')
  435.             END IF
  436.             RETURN
  437.         END IF
  438.         I=HLPTBX(TOPNUM)
  439.  
  440.  100    CALL ZMESS(HLPTXT(I),1)
  441.         IF (HLPTXT(I)(61:61).EQ.')') RETURN
  442.         I=I+1
  443.         GOTO 100
  444.  
  445.  1001   CALL ZMESS('ISTPO - Polish Options Editor',1)
  446.         CALL SKIP(1)
  447.         CALL ZMESS('Menu: DIR                      Next: BASIC',1)
  448.         CALL SKIP(1)
  449.         CALL ZMESS('Menus available:',1)
  450.         CALL ZMESS('  BASIC         - Basic Operating Parameters',
  451.      +             1)
  452.         CALL ZMESS('  COMMON        - Commonly-used Options',1)
  453.         CALL ZMESS('  UNCOMMON      - Uncommon Customisations',1)
  454.         CALL ZMESS('  CONVERSION    - Conversion Options',1)
  455.         CALL ZMESS('  BLANK_LINES   - Blank Line Insertion',1)
  456.         CALL ZMESS('  LINE_BREAK    - Long Line Break Priorities',
  457.      +             1)
  458.         CALL ZMESS('  SPACING1      - Token Spacing Parameters',1)
  459.         CALL ZMESS('  SPACING2      - More Token Spacing Parameters',
  460.      +             1)
  461.         CALL SKIP(2)
  462.         CALL ZMESS('To move to a particular menu, type:',1)
  463.         CALL ZMESS('  MENU name',1)
  464.         CALL SKIP(2)
  465.         CALL ZMESS(
  466.      +'Other commands: ?, Exit, Help, Next, Query, Quit, Read, Write',
  467.      +             1)
  468.         CALL SKIP(1)
  469.         RETURN
  470.  
  471.  1002   CALL SKIP(1)
  472.         CALL ZMESS(
  473.      +       'Menu: BASIC                        Next: COMMON',1)
  474.         CALL SKIP(1)
  475.         CALL ZCHOUT('SEQRQD: Add sequence numbers               = ',
  476.      +              1)
  477.         CALL OUTLOG(SEQRQD,1)
  478.         CALL SKIP(1)
  479.         CALL ZCHOUT('RLBFMT: Relabel FORMAT statements          = ',
  480.      +              1)
  481.         CALL OUTLOG(RLBFMT,1)
  482.         CALL ZCHOUT('RLBSTM: Relabel executable statements      = ',
  483.      +              1)
  484.         CALL OUTLOG(RLBSTM,1)
  485.         CALL ZCHOUT('MOVEF : Move FORMAT statements to end      = ',
  486.      +              1)
  487.         CALL OUTLOG(MOVEF,1)
  488.         CALL SKIP(1)
  489.         CALL ZCHOUT('DOCONI: End each DO-loop on a CONTINUE     = ',
  490.      +              1)
  491.         CALL OUTLOG(DOCONI,1)
  492.         CALL ZCHOUT('IOTHCO: Put CONTINUE on each labelled stmt = ',
  493.      +              1)
  494.         CALL OUTLOG(IOTHCO,1)
  495.         CALL SKIP(1)
  496.         CALL ZCHOUT('TRACE : Display progress messages          = ',
  497.      +              1)
  498.         CALL OUTLOG(TRACE,1)
  499.         CALL SKIP(1)
  500.         CALL ZCHOUT('ERRCMT: Insert er'//
  501.      +              'ror messages as comments  = ',1)
  502.         CALL OUTLOG(ERRCMT,1)
  503.         CALL SKIP(1)
  504.         CALL ZCHOUT('CONCHR: Continuation character             = ',
  505.      +              1)
  506.         CALL OUTCCH(CONCHR,1)
  507.         CALL SKIP(2)
  508.         CALL ZMESS('Type ? for help',1)
  509.         CALL SKIP(1)
  510.         RETURN
  511.  
  512.  1003   CALL SKIP(1)
  513.         CALL ZMESS('Menu: COMMON                       Next: UNCOMMON',
  514.      +             1)
  515.         CALL SKIP(1)
  516.         CALL ZCHOUT('SEQINI: Initial Sequence Number          = ',1)
  517.         CALL PUTDEC(SEQINI,1)
  518.         CALL PUTC(10)
  519.         CALL ZCHOUT('SEQINC: Sequence Number Increment        = ',1)
  520.         CALL PUTDEC(SEQINC,1)
  521.         CALL PUTC(10)
  522.         CALL ZCHOUT('SEQDIG: Number of digits in seq num'//
  523.      +              'ber   = ',1)
  524.         CALL PUTDEC(SEQDIG,1)
  525.         CALL PUTC(10)
  526.         CALL ZCHOUT('SEQFIL: Fill character for seq num'//
  527.      +              'ber    = ''',1)
  528.         CALL PUTC(SEQFIL)
  529.         CALL ZMESS('''',1)
  530.         CALL SKIP(1)
  531.         CALL ZCHOUT('SLBINI: Initial statement label          = ',
  532.      +              1)
  533.         CALL PUTDEC(SLBINI,1)
  534.         CALL PUTC(10)
  535.         CALL ZCHOUT('SLBINC: Statement label increment        = ',
  536.      +              1)
  537.         CALL PUTDEC(SLBINC,1)
  538.         CALL PUTC(10)
  539.         CALL ZCHOUT('FLBINI: Initial FORMAT label             = ',
  540.      +              1)
  541.         CALL PUTDEC(FLBINI,1)
  542.         CALL PUTC(10)
  543.         CALL ZCHOUT('FLBINC: FORMAT label increment           = ',
  544.      +              1)
  545.         CALL PUTDEC(FLBINC,1)
  546.         CALL SKIP(2)
  547.         CALL ZCHOUT('INDDO : Indentation within a DO-loop     = ',
  548.      +              1)
  549.         CALL PUTDEC(INDDO,1)
  550.         CALL PUTC(10)
  551.         CALL ZCHOUT('INDIF : Indentation within a block-IF    = ',
  552.      +              1)
  553.         CALL PUTDEC(INDIF,1)
  554.         CALL PUTC(10)
  555.         CALL ZCHOUT('INDCON: Continuation line indentation    = ',
  556.      +              1)
  557.         CALL PUTDEC(INDCON,1)
  558.         CALL PUTC(10)
  559.         CALL ZCHOUT('INDCMT: Indent comments as statements    = ',
  560.      +              1)
  561.         CALL OUTLOG(INDCMT,1)
  562.         CALL ZCHOUT('INDDOC: Indent DO- CONTINUE''s with body  = ',
  563.      +              1)
  564.         CALL OUTLOG(INDDOC,1)
  565.         CALL SKIP(1)
  566.         CALL ZCHOUT('VLEN  : Padding before "=" for variables = .',
  567.      +              1)
  568.         CALL PUTDEC(VLEN,1)
  569.         CALL SKIP(2)
  570.         RETURN
  571.  
  572.  1004   CALL SKIP(1)
  573.         CALL ZMESS('Menu: UNCOMMON                  Next: CONVERSION',
  574.      +             1)
  575.         CALL SKIP(1)
  576.         CALL ZCHOUT('LMARGS: Left margin for statements       = ',
  577.      +              1)
  578.         CALL PUTDEC(LMARGS,1)
  579.         CALL PUTC(10)
  580.         CALL ZCHOUT('RMARGS: Right margin for statements      = ',
  581.      +              1)
  582.         CALL PUTDEC(RMARGS,1)
  583.         CALL PUTC(10)
  584.         CALL ZCHOUT('LMARGC: Left margin for comments         = ',
  585.      +              1)
  586.         CALL PUTDEC(LMARGC,1)
  587.         CALL PUTC(10)
  588.         CALL ZCHOUT('RMARGC: Right margin for comments        = ',
  589.      +              1)
  590.         CALL PUTDEC(RMARGC,1)
  591.         CALL SKIP(2)
  592.         CALL ZCHOUT('LABELC: Starting column for labels       = ',1)
  593.         CALL PUTDEC(LABELC,1)
  594.         CALL PUTC(10)
  595.         CALL ZCHOUT('LABELF: Label format                     = ',1)
  596.         CALL OUTLBF(LABELF,1)
  597.         CALL SKIP(1)
  598.         CALL ZCHOUT('DLEN  : Declaration keyword length       = ',1)
  599.         CALL PUTDEC(DLEN,1)
  600.         CALL PUTC(10)
  601.         CALL ZCHOUT('DLUP  : Declaration body line-up         = ',1)
  602.         CALL OUTLOG(DLUP,1)
  603.         CALL SKIP(1)
  604.         CALL ZCHOUT('CMMODE: Mode of reading comments         = ',
  605.      +              1)
  606.         CALL OUTCMM(CMMODE,1)
  607.         CALL SKIP(1)
  608.         CALL ZCHOUT('CBOX  : Comment boxing                   = ',1)
  609.         CALL OUTCBX(CBOX,1)
  610.         CALL ZCHOUT('CBTOP : Top of box character             = ',1)
  611.         CALL PUTC(39)
  612.         CALL PUTC(CBTOP)
  613.         CALL ZMESS('''',1)
  614.         CALL ZCHOUT('CBSIDE: Sides of box character           = ',1)
  615.         CALL PUTC(39)
  616.         CALL PUTC(CBSIDE)
  617.         CALL ZMESS('''',1)
  618.         CALL SKIP(1)
  619.         CALL ZCHOUT('CMCHAR: Comment character                = ',1)
  620.         CALL PUTC(39)
  621.         CALL PUTC(CMCHAR)
  622.         CALL PUTC(39)
  623.         CALL SKIP(2)
  624.         CALL ZCHOUT('DELSED: Delete $PL$ SED comments         = ',1)
  625.         CALL OUTLOG(DELSED,1)
  626.         CALL SKIP(1)
  627.         RETURN
  628.  
  629.  1005   CALL SKIP(1)
  630.         CALL ZMESS('Menu: CONVERSION                 Next: BLANK_LINES',
  631.      +             1)
  632.         CALL SKIP(1)
  633.         CALL ZCHOUT('KWCASE: Keyword case                     = ',1)
  634.         CALL OUTKWC(KWCASE,1)
  635.         CALL ZCHOUT('IDCASE: Identifier case                  = ',1)
  636.         CALL OUTCAS(IDCASE,1)
  637.         CALL ZCHOUT('STRCAS: String case                      = ',1)
  638.         CALL OUTCAS(STRCAS,1)
  639.         CALL ZCHOUT('CMCASE: Comment case                     = ',1)
  640.         CALL OUTCAS(CMCASE,1)
  641.         CALL ZCHOUT('FFCASE: Format-field case                = ',1)
  642.         CALL OUTCAS(FFCASE,1)
  643.         CALL SKIP(1)
  644.         CALL ZCHOUT('RMOPCF: Remove optional commas in FORMAT = ',1)
  645.         CALL OUTLOG(RMOPCF,1)
  646.         CALL ZCHOUT('CVTHFM: Convert H-field to character str = ',1)
  647.         CALL OUTLOG(CVTHFM,1)
  648.         CALL ZCHOUT('FMSBRK: Break strings in FORMAT cleverly = ',1)
  649.         CALL OUTLOG(FMSBRK,1)
  650.         CALL SKIP(1)
  651.         RETURN
  652.  
  653.  1006   CALL SKIP(1)
  654.         CALL ZMESS('Menu: BLANK_LINES                Next: LINE_BREAK',
  655.      +             1)
  656.         CALL SKIP(1)
  657.         CALL ZCHOUT('BLADEC: Blank line after declarations = ',1)
  658.         CALL OUTLOG(BLADEC,1)
  659.         CALL ZCHOUT('BLCHAR: Blank line initial character  = ',1)
  660.         CALL PUTC(39)
  661.         CALL PUTC(BLCHAR)
  662.         CALL ZMESS('''',1)
  663.         CALL ZMESS('BLAFT(token): Blank line after statement starting wi
  664.      +th token=',1)
  665.         CALL PUTC(32)
  666.         DO 10061 I=TASSIG,TDCMPL
  667.             CALL ZCHOUT('('//TOKNAM(I)//')=',1)
  668.             CALL PUTDEC(BLAFT(I),1)
  669.             IF (MOD(I-1,7).EQ.0) CALL PUTC(10)
  670.             CALL PUTC(32)
  671. 10061   CONTINUE
  672.         CALL ZCHOUT('('//TOKNAM(TNAME)//')=',1)
  673.         CALL PUTDEC(BLAFT(TNAME),1)
  674.         CALL PUTC(10)
  675.         CALL ZMESS('BLBEF(token): Blank line before statement starting w
  676.      +ith token=',1)
  677.         CALL PUTC(32)
  678.         DO 10062 I=TASSIG,TDCMPL
  679.             CALL ZCHOUT('('//TOKNAM(I)//')=',1)
  680.             CALL PUTDEC(BLBEF(I),1)
  681.             IF (MOD(I-1,7).EQ.0) CALL PUTC(10)
  682.             CALL PUTC(32)
  683. 10062   CONTINUE
  684.         CALL ZCHOUT('('//TOKNAM(TNAME)//')=',1)
  685.         CALL PUTDEC(BLBEF(TNAME),1)
  686.         CALL SKIP(2)
  687.         RETURN
  688.  
  689.  1007   CALL SKIP(1)
  690.         CALL ZMESS('Menu: LINE_BREAK                   Next: SPACING1',
  691.      +             1)
  692.         CALL SKIP(1)
  693.         CALL ZCHOUT('BRKLIF: Break logical IF after cond= ',1)
  694.         CALL OUTLOG(BRKLIF,1)
  695.         CALL ZMESS('BRPRIO(token): Line break priority at parenthesis le
  696.      +vels 0, 1 & 2+',1)
  697.         CALL ZCHOUT(' '//TOKNAM(-2)//'=',1)
  698.         CALL PUTBRP(BRPRIO,-2,1)
  699.         CALL PUTC(32)
  700.         CALL ZCHOUT(TOKNAM(-1)//'=',1)
  701.         CALL PUTBRP(BRPRIO,-1,1)
  702.         CALL PUTC(32)
  703.         DO 10071 I=TASSIG,TZEOS
  704.             CALL ZCHOUT(TOKNAM(I)//'=',1)
  705.             CALL PUTBRP(BRPRIO,I,1)
  706.             IF (MOD(I-1,5).EQ.3) CALL PUTC(10)
  707. 10071       CALL PUTC(32)
  708.         CALL ZCHOUT(TOKNAM(TFMTKD)//'=',1)
  709.         CALL PUTBRP(BRPRIO,TFMTKD,1)
  710.         CALL PUTC(10)
  711.         CALL ZCHOUT(' '//TOKNAM(TENDKD)//'=',1)
  712.         CALL PUTBRP(BRPRIO,TENDKD,1)
  713.         CALL ZCHOUT(' '//TOKNAM(TERRKD)//'=',1)
  714.         CALL PUTBRP(BRPRIO,TERRKD,1)
  715.         CALL SKIP(2)
  716.         RETURN
  717.  
  718.  1008   CALL SKIP(1)
  719.         CALL ZMESS('Menu: SPACING1                     Next: SPACING2.',
  720.      +             1)
  721.         CALL SKIP(1)
  722.         CALL ZMESS('SPBEF(token): Spaces before token at parenthesis '//
  723.      +'levels 0, 1 & 2+ =',1)
  724.         DO 10081 I=-2,TKLAST
  725.             IF (I.NE.0 .AND. I.NE.1) THEN
  726.                 CALL ZCHOUT(' '//TOKNAM(I)//'=',1)
  727.                 CALL ZPTINT(SPBEF(I,0),2,1)
  728.                 CALL PUTC(44)
  729.                 CALL ZPTINT(SPBEF(I,1),2,1)
  730.                 CALL PUTC(44)
  731.                 CALL ZPTINT(SPBEF(I,2),2,1)
  732.                 IF (I.GT.0 .AND. MOD(I-1,5).EQ.3) CALL PUTC(10)
  733.             END IF
  734. 10081   CONTINUE
  735.         CALL SKIP(2)
  736.         RETURN
  737.  
  738.  1009   CALL SKIP(1)
  739.         CALL ZMESS('Menu: SPACING2                     Next: DIR',
  740.      +             1)
  741.         CALL SKIP(1)
  742.         CALL ZMESS('SPAFT(token): Spaces after token at parenthesis '//
  743.      +'levels 0, 1 & 2+ =',1)
  744.         DO 10091 I=-2,TKLAST
  745.             IF (I.NE.0 .AND. I.NE.1) THEN
  746.                 CALL ZCHOUT(' '//TOKNAM(I)//'=',1)
  747.                 CALL ZPTINT(SPAFT(I,0),2,1)
  748.                 CALL PUTC(44)
  749.                 CALL ZPTINT(SPAFT(I,1),2,1)
  750.                 CALL PUTC(44)
  751.                 CALL ZPTINT(SPAFT(I,2),2,1)
  752.                 IF (I.GT.0 .AND. MOD(I-1,5).EQ.3) CALL PUTC(10)
  753.             END IF
  754. 10091   CONTINUE
  755.         CALL SKIP(2)
  756.  
  757.         END
  758. C ----------------------------------------------------------------------
  759. C
  760. C       W R F I L E  -  Write Options File
  761. C
  762.  
  763.         SUBROUTINE WRFILE(OPTPTH)
  764.         INTEGER OPTPTH(*)
  765.  
  766. C---------------------------------------------------------
  767. C    TOOLPACK/1    Release: 2.5
  768. C---------------------------------------------------------
  769. C
  770. C  TKLAST = LAST TOKEN NUMBER
  771. C
  772.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  773.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  774.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  775.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  776.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  777.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  778.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  779.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  780.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  781.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  782.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  783.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  784.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  785.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  786.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  787.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  788.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  789.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  790.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  791.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  792.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  793.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  794.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  795.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  796.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  797.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  798.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  799.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  800.  
  801.  
  802.         COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
  803.         INTEGER LMARGS,RMARGS,LMARGC,RMARGC
  804.  
  805.         COMMON/CONTIN/CONCHR,CONCNT
  806.         INTEGER CONCHR,CONCNT
  807.  
  808.         COMMON/LFORM/LABELF,LABELC
  809.         INTEGER LABELF,LABELC
  810.  
  811.         COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
  812.         INTEGER INDDO,INDIF,INDCON,MAXIND
  813.         LOGICAL INDCMT
  814.  
  815.         COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
  816.         INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
  817.         LOGICAL SEQRQD
  818.  
  819.         COMMON/SPACNG/SPBEF,SPAFT
  820.         INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
  821.  
  822.         COMMON/INTBRK/BRPRIO
  823.         INTEGER BRPRIO(-2:TKLAST,0:2)
  824.  
  825.         COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
  826.         INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
  827.         LOGICAL BLADEC
  828.  
  829.         COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
  830.         INTEGER FLBINI,FLBINC,SLBINI,SLBINC
  831.         LOGICAL RLBFMT,RLBSTM
  832.  
  833.         COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
  834.         LOGICAL DOCONI,IOTHCO
  835.         INTEGER NDOCON,DOCONS(30)
  836.  
  837.         COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  838.         INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
  839.  
  840.         COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  841.         INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
  842.  
  843.         COMMON/MOVFMT/MOVEF,MFFLAG
  844.         LOGICAL MOVEF,MFFLAG
  845.  
  846.         COMMON/ASGLUP/VLEN
  847.         INTEGER VLEN
  848.  
  849.         COMMON/DECLUP/DLUP,DLEN,DLUPOS
  850.         LOGICAL DLUP
  851.         INTEGER DLEN,DLUPOS
  852.  
  853.         COMMON/TRCOPT/TRACE
  854.         LOGICAL TRACE
  855.  
  856.         COMMON/OPT15C/INDDOC,DELSED,BRKLIF
  857.         LOGICAL INDDOC,DELSED,BRKLIF
  858.  
  859.         COMMON/ERROPT/ERRCMT
  860.         LOGICAL ERRCMT
  861.  
  862.         COMMON/CVTOPT/CVTHFM,FMSBRK
  863.         LOGICAL CVTHFM,FMSBRK
  864.  
  865.         COMMON/REMTOK/RMOPCF
  866.         LOGICAL RMOPCF
  867.  
  868.         COMMON/TNAMES/TOKNAM
  869.         CHARACTER*6 TOKNAM(-2:TKLAST)
  870.  
  871.         INTEGER FPRMPT(19)
  872.  
  873.         SAVE
  874.  
  875.         INTEGER IOD,JUNK,I,J
  876.  
  877.         INTEGER ZGTCMD,CREATE
  878.         EXTERNAL REMARK,ZPRMPT,ZGTCMD,CREATE,ZCHOUT,ZPTINT,PUTCH,ZMESS
  879.  
  880.         DATA FPRMPT/79,112,116,105,111,110,32,102,105,108,
  881.      +              101,32,110,97,109,101,58,32,129/
  882.  
  883.         IOD=CREATE(OPTPTH,1)
  884.         IF (IOD.EQ.-1) THEN
  885.             CALL CANT(OPTPTH)
  886.             CALL ZPRMPT(FPRMPT)
  887.             JUNK=ZGTCMD(OPTPTH,0)
  888.             IOD=CREATE(OPTPTH,1)
  889.         END IF
  890.         IF (IOD.EQ.-1) THEN
  891.             CALL REMARK('File creation failed - command aborted')
  892.             RETURN
  893.         END IF
  894. C /TRCOPT/
  895.         CALL ZCHOUT('TRACE=',IOD)
  896.         CALL OUTLOG(TRACE,IOD)
  897. C /MARGIN/
  898.         CALL ZCHOUT('LMARGS=',IOD)
  899.         CALL ZPTINT(LMARGS,1,IOD)
  900.         CALL PUTCH(10,IOD)
  901.         CALL ZCHOUT('RMARGS=',IOD)
  902.         CALL ZPTINT(RMARGS,1,IOD)
  903.         CALL PUTCH(10,IOD)
  904.         CALL ZCHOUT('LMARGC=',IOD)
  905.         CALL ZPTINT(LMARGC,1,IOD)
  906.         CALL PUTCH(10,IOD)
  907.         CALL ZCHOUT('RMARGC=',IOD)
  908.         CALL ZPTINT(RMARGC,1,IOD)
  909.         CALL PUTCH(10,IOD)
  910. C /CONTIN/
  911.         CALL ZCHOUT('CONCHR=',IOD)
  912.         CALL OUTCCH(CONCHR,IOD)
  913. C /LFORM/
  914.         CALL ZCHOUT('LABELC=',IOD)
  915.         CALL ZPTINT(LABELC,1,IOD)
  916.         CALL PUTCH(10,IOD)
  917.         CALL ZCHOUT('LABELF=',IOD)
  918.         CALL OUTLBF(LABELF,IOD)
  919. C /INDENT/
  920.         CALL ZCHOUT('INDDO=',IOD)
  921.         CALL ZPTINT(INDDO,1,IOD)
  922.         CALL PUTCH(10,IOD)
  923.         CALL ZCHOUT('INDIF=',IOD)
  924.         CALL ZPTINT(INDIF,1,IOD)
  925.         CALL PUTCH(10,IOD)
  926.         CALL ZCHOUT('INDCON=',IOD)
  927.         CALL ZPTINT(INDCON,1,IOD)
  928.         CALL PUTCH(10,IOD)
  929.         CALL ZCHOUT('INDCMT=',IOD)
  930.         CALL OUTLOG(INDCMT,IOD)
  931. C /SEQNUM/
  932.         CALL ZCHOUT('SEQRQD=',IOD)
  933.         CALL OUTLOG(SEQRQD,IOD)
  934.         CALL ZCHOUT('SEQINI=',IOD)
  935.         CALL ZPTINT(SEQINI,1,IOD)
  936.         CALL PUTCH(10,IOD)
  937.         CALL ZCHOUT('SEQINC=',IOD)
  938.         CALL ZPTINT(SEQINC,1,IOD)
  939.         CALL PUTCH(10,IOD)
  940.         CALL ZCHOUT('SEQDIG=',IOD)
  941.         CALL ZPTINT(SEQDIG,1,IOD)
  942.         CALL PUTCH(10,IOD)
  943.         CALL ZCHOUT('SEQFIL=''',IOD)
  944.         CALL PUTCH(SEQFIL,IOD)
  945.         CALL ZMESS('''',IOD)
  946. C /RELBL/
  947.         CALL ZCHOUT('RLBFMT=',IOD)
  948.         CALL OUTLOG(RLBFMT,IOD)
  949.         CALL ZCHOUT('RLBSTM=',IOD)
  950.         CALL OUTLOG(RLBSTM,IOD)
  951.         CALL ZCHOUT('FLBINI=',IOD)
  952.         CALL ZPTINT(FLBINI,1,IOD)
  953.         CALL PUTCH(10,IOD)
  954.         CALL ZCHOUT('FLBINC=',IOD)
  955.         CALL ZPTINT(FLBINC,1,IOD)
  956.         CALL PUTCH(10,IOD)
  957.         CALL ZCHOUT('SLBINI=',IOD)
  958.         CALL ZPTINT(SLBINI,1,IOD)
  959.         CALL PUTCH(10,IOD)
  960.         CALL ZCHOUT('SLBINC=',IOD)
  961.         CALL ZPTINT(SLBINC,1,IOD)
  962.         CALL PUTCH(10,IOD)
  963. C /DOCON/
  964.         CALL ZCHOUT('DOCONI=',IOD)
  965.         CALL OUTLOG(DOCONI,IOD)
  966.         CALL ZCHOUT('IOTHCO=',IOD)
  967.         CALL OUTLOG(IOTHCO,IOD)
  968. C /CMT/
  969.         CALL ZCHOUT('CMMODE=',IOD)
  970.         CALL OUTCMM(CMMODE,IOD)
  971.         CALL ZCHOUT('CBOX=',IOD)
  972.         CALL OUTCBX(CBOX,IOD)
  973.         CALL ZCHOUT('CBTOP=',IOD)
  974.         CALL PUTCH(39,IOD)
  975.         CALL PUTCH(CBTOP,IOD)
  976.         CALL ZMESS('''',IOD)
  977.         CALL ZCHOUT('CBSIDE=',IOD)
  978.         CALL PUTCH(39,IOD)
  979.         CALL PUTCH(CBSIDE,IOD)
  980.         CALL ZMESS('''',IOD)
  981.         CALL ZCHOUT('CMCHAR=',IOD)
  982.         CALL PUTCH(39,IOD)
  983.         CALL PUTCH(CMCHAR,IOD)
  984.         CALL ZMESS('''',IOD)
  985. C /CASE/
  986.         CALL ZCHOUT('KWCASE=',IOD)
  987.         CALL OUTKWC(KWCASE,IOD)
  988.         CALL ZCHOUT('IDCASE=',IOD)
  989.         CALL OUTCAS(IDCASE,IOD)
  990.         CALL ZCHOUT('STRCAS=',IOD)
  991.         CALL OUTCAS(STRCAS,IOD)
  992.         CALL ZCHOUT('CMCASE=',IOD)
  993.         CALL OUTCAS(CMCASE,IOD)
  994.         CALL ZCHOUT('FFCASE=',IOD)
  995.         CALL OUTCAS(FFCASE,IOD)
  996. C /ASGLUP/
  997.         CALL ZCHOUT('VLEN=',IOD)
  998.         CALL ZPTINT(VLEN,1,IOD)
  999.         CALL PUTCH(10,IOD)
  1000. C /DECLUP/
  1001.         CALL ZCHOUT('DLUP=',IOD)
  1002.         CALL OUTLOG(DLUP,IOD)
  1003.         CALL ZCHOUT('DLEN=',IOD)
  1004.         CALL ZPTINT(DLEN,1,IOD)
  1005.         CALL PUTCH(10,IOD)
  1006. C /MOVFMT/
  1007.         CALL ZCHOUT('MOVEF=',IOD)
  1008.         CALL OUTLOG(MOVEF,IOD)
  1009. C /SPACNG/,/INTBRK/,/BLINES/
  1010.         CALL ZCHOUT('BLADEC=',IOD)
  1011.         CALL OUTLOG(BLADEC,IOD)
  1012.         CALL ZCHOUT('BLCHAR=''',IOD)
  1013.         CALL PUTCH(BLCHAR,IOD)
  1014.         CALL ZMESS('''',IOD)
  1015.         DO 400 I=-2,TKLAST
  1016.             IF (I.NE.0) THEN
  1017.                 CALL ZCHOUT('BLBEF('//TOKNAM(I)//')=',IOD)
  1018.                 CALL ZPTINT(BLBEF(I),1,IOD)
  1019.                 CALL PUTCH(10,IOD)
  1020.                 CALL ZCHOUT('BLAFT('//TOKNAM(I)//')=',IOD)
  1021.                 CALL ZPTINT(BLAFT(I),1,IOD)
  1022.                 CALL PUTCH(10,IOD)
  1023.                 CALL ZCHOUT('BRPRIO('//TOKNAM(I)//')=',IOD)
  1024.                 CALL PUTBRP(BRPRIO,I,IOD)
  1025.                 CALL PUTCH(10,IOD)
  1026.                 CALL ZCHOUT('SPBEF('//TOKNAM(I)//')=',IOD)
  1027.                 DO 200 J=0,2
  1028.                     CALL ZPTINT(SPBEF(I,J),1,IOD)
  1029.  200                CALL PUTCH(32,IOD)
  1030.                 CALL PUTCH(10,IOD)
  1031.                 CALL ZCHOUT('SPAFT('//TOKNAM(I)//')=',IOD)
  1032.                 DO 300 J=0,2
  1033.                     CALL ZPTINT(SPAFT(I,J),1,IOD)
  1034.  300                CALL PUTCH(32,IOD)
  1035.                 CALL PUTCH(10,IOD)
  1036.             END IF
  1037.  400    CONTINUE
  1038. C /OPT15C/
  1039.         CALL ZCHOUT('INDDOC=',IOD)
  1040.         CALL OUTLOG(INDDOC,IOD)
  1041.         CALL ZCHOUT('DELSED=',IOD)
  1042.         CALL OUTLOG(DELSED,IOD)
  1043.         CALL ZCHOUT('BRKLIF=',IOD)
  1044.         CALL OUTLOG(BRKLIF,IOD)
  1045. C /REMTOK/
  1046.         CALL ZCHOUT('RMOPCF=',IOD)
  1047.         CALL OUTLOG(RMOPCF,IOD)
  1048. C /ERROPT/
  1049.         CALL ZCHOUT('ERRCMT=',IOD)
  1050.         CALL OUTLOG(ERRCMT,IOD)
  1051. C /CVTOPT/
  1052.         CALL ZCHOUT('CVTHFM=',IOD)
  1053.         CALL OUTLOG(CVTHFM,IOD)
  1054.         CALL ZCHOUT('FMSBRK=',IOD)
  1055.         CALL OUTLOG(FMSBRK,IOD)
  1056.  
  1057.         CALL CLOSE(IOD)
  1058.  
  1059.         END
  1060. C ----------------------------------------------------------------------
  1061. C
  1062. C       O U T L O G  -  Output .TRUE./.FALSE.
  1063. C
  1064.  
  1065.         SUBROUTINE OUTLOG(LOGVAR,IOD)
  1066.         LOGICAL LOGVAR
  1067.         INTEGER IOD
  1068.  
  1069.         EXTERNAL ZMESS
  1070.  
  1071.         IF (LOGVAR) THEN
  1072.             CALL ZMESS('..TRUE..',IOD)
  1073.         ELSE
  1074.             CALL ZMESS('..FALSE..',IOD)
  1075.         END IF
  1076.  
  1077.         END
  1078. C ----------------------------------------------------------------------
  1079. C
  1080. C       O U T C M M  -  Output name for CMMODE
  1081. C
  1082.  
  1083.         SUBROUTINE OUTCMM(CMMODE,IOD)
  1084.         INTEGER CMMODE,IOD
  1085.  
  1086.         EXTERNAL ZMESS
  1087.  
  1088.         IF (CMMODE.EQ.0) THEN
  1089.             CALL ZMESS('normal',IOD)
  1090.         ELSE IF (CMMODE.EQ.1) THEN
  1091.             CALL ZMESS('skip_leading_blanks',IOD)
  1092.         ELSE IF (CMMODE.EQ.2) THEN
  1093.             CALL ZMESS('verbatim',IOD)
  1094.         ELSE
  1095.             CALL ZMESS('truncate',IOD)
  1096.         END IF
  1097.  
  1098.         END
  1099. C ----------------------------------------------------------------------
  1100. C
  1101. C       O U T C C H  -  Output name for CONCHR
  1102. C
  1103.  
  1104.         SUBROUTINE OUTCCH(CONCHR,IOD)
  1105.         INTEGER CONCHR,IOD
  1106.  
  1107.         EXTERNAL ZMESS,PUTCH
  1108.  
  1109.         IF (CONCHR.EQ.1) THEN
  1110.             CALL ZMESS('numeric',IOD)
  1111.         ELSE IF (CONCHR.EQ.2) THEN
  1112.             CALL ZMESS('alphabetic',IOD)
  1113.         ELSE IF (CONCHR.EQ.3) THEN
  1114.             CALL ZMESS('alphanumeric',IOD)
  1115.         ELSE
  1116.             CALL PUTCH(39,IOD)
  1117.             CALL PUTCH(CONCHR,IOD)
  1118.             CALL ZMESS('''',IOD)
  1119.         END IF
  1120.  
  1121.         END
  1122. C ----------------------------------------------------------------------
  1123. C
  1124. C       O U T L B F  -  Output text for LABELF
  1125. C
  1126.  
  1127.         SUBROUTINE OUTLBF(LABELF,IOD)
  1128.         INTEGER LABELF,IOD
  1129.  
  1130.         EXTERNAL ZMESS
  1131.  
  1132.         IF (LABELF.EQ.0) THEN
  1133.             CALL ZMESS('left_justified',IOD)
  1134.         ELSE IF (LABELF.EQ.1) THEN
  1135.             CALL ZMESS('right_justified',IOD)
  1136.         ELSE
  1137.             CALL ZMESS('zero_padded',IOD)
  1138.         END IF
  1139.  
  1140.         END
  1141. C ----------------------------------------------------------------------
  1142. C
  1143. C       O U T K W C  -  Output name for keyword-case
  1144. C
  1145.  
  1146.         SUBROUTINE OUTKWC(KWCASE,IOD)
  1147.         INTEGER KWCASE,IOD
  1148.  
  1149.         EXTERNAL ZMESS
  1150.  
  1151.         IF (KWCASE.EQ.0) THEN
  1152.             CALL ZMESS('Uppercase',IOD)
  1153.         ELSE IF (KWCASE.EQ.1) THEN
  1154.             CALL ZMESS('Lowercase',IOD)
  1155.         ELSE
  1156.             CALL ZMESS('Mixedcase',IOD)
  1157.         END IF
  1158.  
  1159.         END
  1160. C ----------------------------------------------------------------------
  1161. C
  1162. C       O U T C A S  -  Output text for other case-conversion
  1163. C
  1164.  
  1165.         SUBROUTINE OUTCAS(CASE,IOD)
  1166.         INTEGER CASE,IOD
  1167.  
  1168.         EXTERNAL ZMESS
  1169.  
  1170.         IF (CASE.EQ.0) THEN
  1171.             CALL ZMESS('Original_case',IOD)
  1172.         ELSE IF (CASE.EQ.1) THEN
  1173.             CALL ZMESS('Uppercase',IOD)
  1174.         ELSE IF (CASE.EQ.2) THEN
  1175.             CALL ZMESS('Lowercase',IOD)
  1176.         ELSE IF (CASE.EQ.3) THEN
  1177.             CALL ZMESS('Mixedcase',IOD)
  1178.         ELSE
  1179.             CALL ZMESS('Invertcase',IOD)
  1180.         END IF
  1181.  
  1182.         END
  1183. C ----------------------------------------------------------------------
  1184. C
  1185. C       O U T C B X  -  Output text for CBOX value
  1186. C
  1187.  
  1188.         SUBROUTINE OUTCBX(CBOX,IOD)
  1189.         INTEGER CBOX,IOD
  1190.  
  1191.         EXTERNAL ZMESS
  1192.  
  1193.         IF (CBOX.EQ.0) THEN
  1194.             CALL ZMESS('none',IOD)
  1195.         ELSE IF (CBOX.EQ.1) THEN
  1196.             CALL ZMESS('half_box',IOD)
  1197.         ELSE IF (CBOX.EQ.2) THEN
  1198.             CALL ZMESS('whole_box',IOD)
  1199.         END IF
  1200.  
  1201.         END
  1202. C ----------------------------------------------------------------------
  1203. C
  1204. C       P U T B R P  -  Put break-priority value to IOD
  1205. C
  1206.  
  1207.         SUBROUTINE PUTBRP(BRPRIO,I,IOD)
  1208. C---------------------------------------------------------
  1209. C    TOOLPACK/1    Release: 2.5
  1210. C---------------------------------------------------------
  1211. C
  1212. C  TKLAST = LAST TOKEN NUMBER
  1213. C
  1214.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1215.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1216.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1217.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1218.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1219.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1220.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1221.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1222.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1223.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1224.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1225.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1226.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1227.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1228.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1229.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1230.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1231.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1232.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1233.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1234.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1235.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1236.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1237.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1238.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1239.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1240.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1241.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1242.  
  1243.         INTEGER BRPRIO(-2:TKLAST,0:2),I,IOD
  1244.  
  1245.         EXTERNAL ZPTINT,PUTCH
  1246.  
  1247.         CALL ZPTINT(BRPRIO(I,0),2,IOD)
  1248.         CALL PUTCH(44,IOD)
  1249.         CALL ZPTINT(BRPRIO(I,1),2,IOD)
  1250.         CALL PUTCH(44,IOD)
  1251.         CALL ZPTINT(BRPRIO(I,2),2,IOD)
  1252.  
  1253.         END
  1254.